' DRWSCR08.TXT
' DrawScript Routines
'  Version 0.8
'  9/19/92
'
' Jim McClure (76666,1303)
'
' Sorry about uploading this as TEXT. I'll PKZIP next time...
'
' These routines are designed to simplify the programming of a 
'  Print Preview capability for text-oriented reports. The routines
'  record the sequence of Prints, Tabs, etc., for later
'  playback to one or more objects (e.g., Printer object,
'  picture control, etc.). The routines also provide pagination with
'  header/footer control.
'
' That's the good news. Now for the bad news. I'm still struggling with
'  finding a good way to scale the text output for screen display so that
'  it matches printer output. Currently, a point size of 8 is used for
'  screen display because of some problems with printing sizes < 8. I
'  will upload a revised display strategy later. For now, just use a
'  picture control that scrolls vert. and horiz. A point size of 8 is
'  more easily readable anyway!
'
' WARNING!
' This code is still very much under development! I will be uploading
'  revised versions periodically if there's enough interest. I will
'  also try to upload an entire mini-project next, showing how to
'  use the routines. In the meantime, EXPECT BUGS! Feel free to make
'  enhancements, etc. (e.g., adding better line/box support would
'  be nice). I'll be happy to share whatever improvements I make...
'
' But first I have to get some sleep! <g>
'
'
'----------------------------------
'Here is some example usage of the routines
'
'
'First, provide your own routine called "dsBoundaryPrint" to
' print headers and footers (boundaries) as needed. Your
' dsBoundaryPrint routine will be called as follows:
'
' Sub dsBoundaryPrint(Region as integer, PageNum as integer)
'
'In your routine, you can use dsPrint, dsTab, etc., calls to print
' a nice header (if Region = 1) or footer (if Region = 2) for
' your report. Just be sure to print the same # of lines that
' you specify in the dsNew() function below.
'
'Create a new draw script for output page size of 60 lines,
' with 5 lines reserved for the header and 5 lines reserved for the
' footer, using the base font "Helv" point size 12:
'
' hDS% = dsNew(60, 5, 5, "Helv", 12)
'
'Print a few things to it:
'
' dsPrintNL "Hello World!"
' dsTab 30
' dsPrintNL "This is indented!"
' dsFontUnderLine TRUE
' dsPrintNL "This is underlined!"
' dsFontUnderLine FALSE
' dsPrintAttr "This is also underlined!", "U"   'U = underline
' dsNL 'This finishes prior line
' dsLine 'This draws a simple separator line on the output
' (NOTE: The separator doesn't take up a "line" of output-- it leaves
'  the print cursor where it is.)
'
'Ok, we're done formatting
' dsClose(hDS%)
'
'Find out how many pages were generated
' nPages = dsMaxPages()
'
'(Remember, each page will have the appropriate header/footer
' provided by your dsBoundaryPrint routine.)
'
'Play them all back to the printer, starting at page #1
' dsPlay hDS%, DummyControl, TRUE, 1, nPages 'TRUE=Send to printer
'
'Play one page of same report back to a picture box-- start at page #3 this time
' dsPlay hDS%, RealPictureControl, FALSE, 3, 1
'(Now, set up a scroll bar or set of buttons to keep calling
' dsPlay with a larger PageStart, or allow user to jump directly
' to page # by entering it)
'
'Ok, don't need this draw script anymore
' dsFree(hDS%)
'(If you don't do this, a temp file will be left behind!)
'
'GOOD LUCK!
' Jim

'----------------------------------
'This goes in your Global.Bas module

'DrawScript data structure
Type DrawScriptType
  Alloc As Integer
  FileNum As Integer
  FileName As String
  MaxLines As Integer
  HeaderLines As Integer
  FooterLines As Integer
  CurLine As Integer
  CurPage As Integer
  MaxPages As Integer
End Type

'----------------------------------
'This can go in a module called DrawScrpt.Bas

'Allocate array of DrawScript structures
Const nDrawScripts = 5
Dim DrawScript(nDrawScripts) As DrawScriptType

'The following hold the 'current' DS
Dim dsCurrent As Integer
Dim dsFileNum As Integer
Dim dsMaxLines As Integer, dsHeaderLines As Integer, dsFooterLines As Integer
Dim dsCurLine As Integer
Dim dsInBoundary As Integer
Dim dsCurPage As Integer, dsMaxPageNum As Integer

'----------------------------------
'Here come the routines

Sub dsPrint (PrintString As String)
  'Print a string to the current DS
  '
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Print string
  Print #dsFileNum, "PR " + PrintString
End Sub

Sub dsPlay (hDS As Integer, c As Control, ToPrinter As Integer, PageStart As Integer, NumPages As Integer)
  'Replay draw script on output device
  'Either the Printer object (if ToPrinter is true)
  ' or to the supplied control "c" (e.g., form, picture)
  'Replay starts at PageStart (1st page = 1) and
  'proceeds for NumPages pages
  '
  Dim InpString As String, Cmd As String, Arg As String
  Dim FileNum As Integer, StopNow As Integer
  Dim PageCount As Integer

  'Get a file number for use
  FileNum = FreeFile
  
  'Open the file for processing
  Open DrawScript(hDS).FileName For Input As #FileNum

  'See to starting page
  PageCount = 1
  Do While (PageCount < PageStart) And (Not EOF(FileNum))
    'Read each line from the file
    Line Input #FileNum, InpString

    'Increment page count
    If Left$(InpString, 2) = "NP" Then
      PageCount = PageCount + 1
    End If
  Loop

  'Process file 'till end
  StopNow = FALSE
  Do While (Not EOF(FileNum)) And (Not StopNow)

    'Read each line from the file
    Line Input #FileNum, InpString

    'Separate command from data
    Cmd = Left$(InpString, 2)
    If Len(InpString) > 3 Then
      Arg = Right$(InpString, Len(InpString) - 3)
    Else
      Arg = ""
    End If

    'Depending on which command is present...
    Select Case Cmd
      Case "PR"
        'Print a string
        If ToPrinter Then
          Printer.Print Arg;
        Else
          c.Print Arg;
        End If
      Case "NL"
        'Start a new line
        If ToPrinter Then
          Printer.Print
        Else
          c.Print
        End If
      Case "TB"
        'Tab to specified location
        If ToPrinter Then
          Printer.Print Tab(Val(Arg));
        Else
          c.Print Tab(Val(Arg));
        End If
      Case "LN"
        'Draw separator line
        If ToPrinter Then
          Printer.Line -Step(Printer.ScaleWidth, 0)
          Printer.CurrentX = 0
        Else
          c.Line -Step(c.Width, 0)
          c.CurrentX = 0
        End If
      Case "FB"
        'Set FontBold property
        If ToPrinter Then
          Printer.FontBold = Val(Arg)
        Else
          c.FontBold = Val(Arg)
        End If
      Case "FU"
        'Set FontUnderline property
        If ToPrinter Then
          Printer.FontUnderline = Val(Arg)
        Else
          c.FontUnderline = Val(Arg)
        End If
      Case "FI"
        'Set FontItalic property
        If ToPrinter Then
          Printer.FontItalic = Val(Arg)
        Else
          c.FontItalic = Val(Arg)
        End If
      Case "FS"
        'Set FontStrikethru property
        If ToPrinter Then
          Printer.FontStrikethru = Val(Arg)
        Else
          c.FontStrikethru = Val(Arg)
        End If
      Case "FZ"
        'Set FontSize property
        If ToPrinter Then
          Printer.FontSize = Val(Arg)
        Else
          'Scale font size for screen
          c.FontSize = 8
        End If
      Case "FN"
        'Set FontName property
        If ToPrinter Then
          Printer.FontName = Arg
        Else
          c.FontName = Arg
        End If
      Case "NP"
        'Start new page
        If ToPrinter Then
          Printer.NewPage
        End If

        'Keep track of # of pages
        PageCount = PageCount + 1

        'See if we should quit
        If (Not ToPrinter) Or (PageCount = PageStart + NumPages) Then
          StopNow = TRUE
        End If
    End Select
  Loop

  'Done with file
  Close #FileNum

  'If done with printer, close it
  If ToPrinter Then
    Printer.EndDoc
  End If
End Sub

Function dsNew (MaxLines As Integer, nHeader As Integer, nFooter As Integer, FontName As String, FontSize As Integer) As Integer
  'Returns a handle to a DrawScript structure
  ' or -1 if unable to alloc another structure
  'NOTE: This command does an implicit dsSet() of the
  ' new hDS
  '
  Dim hDS As Integer, i As Integer

  'Look for a free descriptor
  hDS = -1
  For i = 0 To nDrawScripts - 1
    If Not DrawScript(i).Alloc Then hDS = i
  Next i

  'If we could allocate an element
  If hDS >= 0 Then
    'Remember that this element is allocated
    DrawScript(hDS).Alloc = TRUE

    'Get a new file descriptor
    DrawScript(hDS).FileNum = FreeFile

    'Setup filename
    '(Might want to put these files into TEMP dir)
    DrawScript(hDS).FileName = "DSTEMP" + LTrim$(Str$(hDS)) + ".TXT"
    Open DrawScript(hDS).FileName For Output As #DrawScript(hDS).FileNum

    'Set initial font name and size
    Print #DrawScript(hDS).FileNum, "FN " + FontName
    Print #DrawScript(hDS).FileNum, "FZ" + Str$(FontSize)

    'Set rest of data
    DrawScript(hDS).MaxLines = MaxLines
    DrawScript(hDS).HeaderLines = nHeader
    DrawScript(hDS).FooterLines = nFooter
    DrawScript(hDS).CurLine = 0
    DrawScript(hDS).CurPage = 0
    DrawScript(hDS).MaxPages = 0

    'Set current hDS
    dsSet hDS
  End If

  'Return the desired descriptor
  dsNew = hDS
End Function

Sub dsClose (hDS As Integer)
  'Finished outputting drawing commands to this DS

  'First, finish the current page
  If dsCurLine > 0 Then
    dsNewPage
  End If

  'Just close the file
  Close #DrawScript(hDS).FileNum

  'Remember the # of pages
  dsMaxPageNum = dsCurPage
End Sub

Sub dsPrintNL (PrintString As String)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Print string and start new line
  Print #dsFileNum, "PR " + PrintString
  Print #dsFileNum, "NL"
  dsCurLine = dsCurLine + 1
End Sub

Sub dsTab (Col As Integer)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Tab to desired position in output
  Print #dsFileNum, "TB " + LTrim$(Str$(Col))
End Sub

Sub dsLine ()
  'This routine draws a single horizontal separator line
  '
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Just save the command for later
  Print #dsFileNum, "LN"
End Sub

Sub dsFree (hDS As Integer)
  'Done with a draw list-- free it
  'First, remove the temp file
  Kill DrawScript(hDS).FileName

  'Now, mark the descriptor as free
  DrawScript(hDS).Alloc = FALSE
End Sub

Sub dsFontUnderline (Value As Integer)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  Print #dsFileNum, "FU" + Str$(Value)
End Sub

Sub dsFontBold (Value As Integer)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  Print #dsFileNum, "FB" + Str$(Value)
End Sub

Sub dsFontItalic (Value As Integer)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  Print #dsFileNum, "FI" + Str$(Value)
End Sub

Sub dsFontStrikethru (Value As Integer)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  Print #dsFileNum, "FS" + Str$(Value)
End Sub

Sub dsFontSize (Size As Integer)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  Print #dsFileNum, "FZ" + Str$(Size)
End Sub

Sub dsNL ()
  'Force a new line
  '
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Start new line
  Print #dsFileNum, "NL"
  dsCurLine = dsCurLine + 1
End Sub

Sub dsNewPage ()
  'Force a new page on the current DS
  '
  Dim i As Integer

  'Check header/footer
  If Not dsInBoundary Then

    'Generate header, if needed
    'See if we're in the header region
    If dsCurLine = 0 Then
      'If not 1st page
      If dsCurPage > 0 Then
        'Start new page
        Print #dsFileNum, "NP"
      End If

      'Starting new page
      dsCurPage = dsCurPage + 1

      'Activate the header
      dsInBoundary = TRUE
      dsBoundaryPrint 1, dsCurPage
      dsInBoundary = FALSE
    End If
 
    'Skip as many lines as are needed
    For i = dsCurLine To dsMaxLines - dsFooterLines - 1
      dsNL
    Next i

    'Now generate footer
    'See if we're in the footer region
    If dsCurLine = dsMaxLines - dsFooterLines Then
      'Activate the footer
      dsInBoundary = TRUE
      dsBoundaryPrint 2, dsCurPage
      dsInBoundary = FALSE
    End If
  
  End If

  'Reset line count
  dsCurLine = 0
End Sub

Sub dsFontName (FontName As String)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  Print #dsFileNum, "FN " + FontName
End Sub

Sub dsTabPrint (Col As Integer, S As String)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Tab to spec location and print string
  Print #dsFileNum, "TB" + Str$(Col)
  Print #dsFileNum, "PR " + S
End Sub

Sub dsTabPrintNL (Col As Integer, S As String)
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Tab to spec location and print string, following by newline
  Print #dsFileNum, "TB" + Str$(Col)
  Print #dsFileNum, "PR " + S
  Print #dsFileNum, "NL"
  dsCurLine = dsCurLine + 1
End Sub

Sub dsPrintAttr (PrintString As String, Attrs As String)
  'Print string with specified attributes
  '  e.g., "U" = underline
  '        "B" = bold
  '        "S" = strikethru
  '        "I" = italic
  '
  Dim i As Integer
  
  'Process header/footer
  If Not dsInBoundary Then
    dsCheckBoundary
  End If

  'Set each attribute
  For i = 1 To Len(Attrs)
    Print #dsFileNum, "F" + Mid$(Attrs, i, 1) + " -1"
  Next i

  'Print the desired string
  Print #dsFileNum, "PR " + PrintString
  'Turn off the attributes

  For i = 1 To Len(Attrs)
    Print #dsFileNum, "F" + Mid$(Attrs, i, 1) + " 0"
  Next i
End Sub

'This routine may not be fully working yet.
'It's supposed to allow you to have several DS going at once
' and be able to switch between them. Handy for slow DBMSs! (Format
' several reports on the same data at once.)
Sub dsSet (hDS As Integer)
  'Save current DS
  DrawScript(dsCurrent).FileNum = dsFileNum
  DrawScript(dsCurrent).MaxLines = dsMaxLines
  DrawScript(dsCurrent).HeaderLines = dsHeaderLines
  DrawScript(dsCurrent).FooterLines = dsFooterLines
  DrawScript(dsCurrent).CurLine = dsCurLine
  DrawScript(dsCurrent).CurPage = dsCurPage
  DrawScript(dsCurrent).MaxPages = dsMaxPageNum

  'Set new hDS for subsequent calls
  dsCurrent = hDS
  dsFileNum = DrawScript(hDS).FileNum
  dsMaxLines = DrawScript(hDS).MaxLines
  dsHeaderLines = DrawScript(hDS).HeaderLines
  dsFooterLines = DrawScript(hDS).FooterLines
  dsCurLine = DrawScript(hDS).CurLine
  dsCurPage = DrawScript(hDS).CurPage
  dsMaxPageNum = DrawScript(hDS).MaxPages
End Sub

Sub dsCheckBoundary ()
  'This routine checks to see whether we've
  'come to a boundary (header or footer)
  'in the report
  '
  'See if we're in the footer region
  If dsCurLine = dsMaxLines - dsFooterLines Then
    'Activate the footer
    dsInBoundary = TRUE
    dsBoundaryPrint 2, dsCurPage
    dsInBoundary = FALSE

    'Reset line count
    dsCurLine = 0
  End If

  'See if we're in the header region
  If dsCurLine = 0 Then
    'If not 1st page
    If dsCurPage > 0 Then
      'Start new page
      Print #dsFileNum, "NP"
    End If

    'Starting new page
    dsCurPage = dsCurPage + 1

    'Activate the header
    dsInBoundary = TRUE
    dsBoundaryPrint 1, dsCurPage
    dsInBoundary = FALSE
  End If
End Sub

Function dsMaxPages () As Integer
  'This function returns the max # of pages for the current DS
  dsMaxPages = dsMaxPageNum
End Function


'----------------------------------
'Here is a sample boundary print routine
'
' Remember, YOU supply this, so you can put whatever you
'  want in it for titles, etc.
'
Sub dsBoundaryPrint(Region as Integer, PageNum as Integer)
  Select Case Region
    case 1 ' Header
      dsNL
      dsPrintAttr "Quarterly Report", "B"  'Show title in BOLD
      dsNL ' Finish prior line
      dsNL
    case 2 ' Footer
      dsNL
      dsTabPrintNL 40, PageNum ' Show page # on footer
      dsNL
  End Select
End Sub